home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / pcl4p40.zip / TERM.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-21  |  12KB  |  348 lines
  1. (**********************************************)
  2. (*                                            *)
  3. (*      TERM.PAS         March 1993           *)
  4. (*                                            *)
  5. (*  TERM is a simple terminal emulator which  *)
  6. (*  features XMODEM, YMODEM, YMODEM-G, and    *)
  7. (*  ASCII file transfer.                      *)
  8. (*                                            *)
  9. (*  Do NOT select YMODEM-G when using a null  *)
  10. (*  modem cable unless you are certain that   *)
  11. (*  RTS & CTS are reversed -- which is        *)
  12. (*  usually not true.                         *)
  13. (*                                            *)
  14. (*  Remember that you cannot send or receive  *)
  15. (*  binary files with ascii protocol - this   *)
  16. (*  includes many word processor file formats *)
  17. (*  such as used by Wordstar.                 *)
  18. (*                                            *)
  19. (*  This program is donated to the Public     *)
  20. (*  Domain by MarshallSoft Computing, Inc.    *)
  21. (*  It is provided as an example of the use   *)
  22. (*  of the Personal Communications Library.   *)
  23. (*                                            *)
  24. (**********************************************)
  25.  
  26. {$I DEFINES.PAS}
  27.  
  28. program term;
  29. uses term_io, modem_io, xymodem, xypacket, amodem, crc, crt, PCL4P;
  30.  
  31. const
  32.   SIO_BUFFER_SIZE = 2048;
  33.  
  34. Var (* globals *)
  35.   ResetFlag : Boolean;
  36.   Port : Integer;
  37.   SioBuffer : array[0..SIO_BUFFER_SIZE-1] of Byte;
  38.  
  39. function MatchBaud(BaudRate : LongInt) : Integer;
  40. Label 999;
  41. const
  42.    BaudRateArray : array[1..10] of LongInt =
  43.        (300,600,1200,2400,4800,9600,19200,38400,57600,115200);
  44. var
  45.    i : Integer;
  46. begin
  47.    for i := 1 to 10 do if BaudRateArray[i] = BaudRate then
  48.       begin
  49.         MatchBaud := i - 1;
  50.         goto 999
  51.       end;
  52.    (* no match *)
  53.    MatchBaud := -1;
  54. 999: end;
  55.  
  56. procedure MyHalt( Code : Integer );
  57. var
  58.    RetCode : Integer;
  59. begin
  60.    if Code < 0 then SayError( Code,'Halting' );
  61.    if ResetFlag then RetCode := SioDone(Port);
  62.    writeln('*** HALTING ***');
  63.    Halt;
  64. end;
  65.  
  66. (* main program *)
  67.  
  68. label 500;
  69.  
  70. const
  71.   NAK = $15;
  72.   WrongBaud1 = 'Cannot recognize baud rate';
  73.   WrongBaud2 = 'Must be 300,600,1200,2400,4800,9600,19200,38400,57600, or 155200';
  74.  
  75. var
  76.   Filename : String20;
  77.   ResultMsg : String20;
  78.   c : Char;
  79.   BaudRate : LongInt;
  80.   BaudCode : Integer;
  81.   Protocol : Char;
  82.   Buffer  : BufferType;
  83.   RetCode : Integer;
  84.   TheByte : Char;
  85.   i       : Integer;
  86.   MenuMsg : String40;
  87.   StatusMsg : String40;
  88.   GetNameMsg: String40;
  89.   OneKflag : Boolean;
  90.   NCGbyte  : Byte;
  91.   BatchFlag: Boolean;
  92.   Flag : Boolean;
  93.   Version : Integer;
  94.   TermChar : Byte;
  95.   CharPace : Integer;
  96.   Timeout  : Integer;
  97.   EchoFlag : Boolean;
  98. begin   (* main program *)
  99.   InitCRC;
  100.   TextMode(BW80);
  101.   ClrScr;
  102.   Window(1,1,80,24);
  103.   ResetFlag := FALSE;
  104.   Protocol := 'X';
  105.   OneKflag := FALSE;
  106.   NCGbyte := NAK;
  107.   BatchFlag := FALSE;
  108.   MenuMsg := 'Q)uit P)rotocol S)end R)eceive: ';
  109.   GetNameMsg := 'Enter filename: ';
  110.   StatusMsg := 'COM? X  "ESC for menu" ';
  111.   (* fetch PORT # from command line *)
  112.   if ParamCount <> 2 then
  113.     begin
  114.       writeln('USAGE: "TERM <port> <buadrate>" ');
  115.       halt;
  116.     end;
  117.   Val( ParamStr(1),Port, RetCode );
  118.   if RetCode <> 0 then
  119.     begin
  120.       writeln('Port must be 1 to 4');
  121.       Halt;
  122.     end;
  123.   (* COM1 = 0, COM2 = 1, COM3 = 2, COM4 = 3 *)
  124.   Port := Port - 1;
  125.   Val( ParamStr(2),BaudRate, RetCode );
  126.   if RetCode <> 0 then
  127.     begin
  128.       writeln(WrongBaud1);
  129.       writeln(WrongBaud2);
  130.       Halt;
  131.     end;
  132.   BaudCode := MatchBaud(BaudRate);
  133.   if BaudCode < 0 then
  134.     begin
  135.       writeln(WrongBaud1);
  136.       writeln(WrongBaud2);
  137.       halt;
  138.     end;
  139.   (* patch up status message *)
  140.   StatusMsg[4] := chr($31+Port);
  141.   Insert(ParamStr(2),StatusMsg,8);
  142.   WriteMsg(StatusMsg,40);
  143.   if (Port<COM1) or (Port>COM4) then
  144.     begin
  145.       writeln('Port must be 1 to 4');
  146.       Halt
  147.     end;
  148.  
  149.   (*** custom configuration: 4 port card
  150.   RetCode := SioIRQ(COM3,IRQ2);
  151.   RetCode := SioIRQ(COM4,IRQ2);
  152.   ***)
  153.   (*** custom configuration: DigiBoard PC/8
  154.   RetCode := SioPorts(8,COM1,$140);
  155.   RetCode := SioUART(Port,$100+8*Port) ;
  156.   if RetCode < 0 then MyHalt( RetCode );
  157.   RetCode := SioIRQ(Port,IRQ5) ;
  158.   if RetCode < 0 then MyHalt( RetCode );
  159.   ***)
  160.  
  161.   (* setup 2K receive buffer *)
  162.   RetCode := SioRxBuf(Port, Ofs(SioBuffer), Seg(SioBuffer), Size2K);
  163.   if RetCode < 0 then MyHalt( RetCode );
  164.   (* reset port *)
  165.   RetCode := SioReset(Port,BaudCode);
  166.   (* if error then try one more time *)
  167.   if RetCode <> 0 then RetCode := SioReset(Port,BaudCode);
  168.   (* Was port reset ? *)
  169.   if RetCode <> 0 then
  170.     begin
  171.       writeln('Cannot reset COM',Port+1);
  172.       MyHalt( RetCode );
  173.     end;
  174.   (* Port successfully reset *)
  175.   ResetFlag := TRUE;
  176.   ClrScr;
  177.   (* show logon message *)
  178.   WriteLn('TERM 10/18/93');
  179.   Version := SioInfo('V');
  180.   WriteLn('Library Version ',Version div 16,'.',Version mod 16);
  181.   (* specify parity, # stop bits, and word length for port *)
  182.   RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
  183.   if RetCode < 0 then MyHalt( RetCode );
  184.   RetCode := SioRxFlush(Port);
  185.   if RetCode < 0 then MyHalt( RetCode );
  186.   (* set FIFO level if have INS16550 *)
  187.   RetCode := SioFIFO(Port, LEVEL_8);
  188.   if RetCode > 0 then writeln('INS16550 detected');
  189.   (* set DTR & RTS *)
  190.   RetCode := SioDTR(Port,SetPort);
  191.   RetCode := SioRTS(Port,SetPort);
  192. {$IFDEF RTS_CTS_CONTROL}
  193.   (* enable RTS/CTS flow control *)
  194.   RetCode := SioFlow(Port,3*18);
  195.   WriteLn('Hardware flow control enabled');
  196.   Write('CTS = ');
  197.   if SioCTS(Port) > 0 then WriteLn('ON') else WriteLn('OFF');
  198. {$ENDIF}
  199.  
  200. {$IFDEF AT_COMMAND_SET}
  201.   (* send initialization string to modem *)
  202.   SendTo(Port,'!AT!!~');
  203.   SendTo(Port,'!AT E1 S7=60 S11=60 V1 X1 Q0 S0=1!');
  204.   if WaitFor(Port,'OK') then writeln('MODEM ready')
  205.   else writeln('WARNING: Expected OK not received');
  206. {$ENDIF}
  207.  
  208.   (* begin terminal loop *)
  209.   WriteMsg(StatusMsg,40);
  210.   LowVideo;
  211.   while TRUE do
  212.     begin (* while TRUE *)
  213.       (* did user press Ctrl-BREAK ? *)
  214.       if SioBrkKey then
  215.         begin
  216.           writeln('User typed Ctl-BREAK');
  217.           RetCode := SioDone(Port);
  218.           Halt;
  219.         end;
  220.       (* anything incoming over serial port ? *)
  221.       RetCode := SioGetc(Port,0);
  222.       if RetCode < -1 then MyHalt( RetCode );
  223.       if RetCode > -1 then write(chr(RetCode));
  224.       (* has user pressed keyboard ? *)
  225.       if KeyPressed then
  226.         begin (* keypressed *)
  227.           (* read keyboard *)
  228.           TheByte := ReadKey;
  229.           (* quit if user types ESC *)
  230.           if TheByte = chr($1b) then
  231.             begin (* ESC *)
  232.               WriteMsg(MenuMsg,1);
  233.               ReadMsg(ResultMsg,32,1);
  234.               c := UpCase(ResultMsg[1]);
  235.               case c of
  236.                 'Q':  (* QUIT *)
  237.                    begin
  238.                      WriteLn;
  239.                      WriteLn('TERMINATING: User pressed <ESC>');
  240.                      RetCode := SioDone(Port);
  241.                      Halt;
  242.                    end;
  243.                 'P':  (* PROTOCOL *)
  244.                    begin
  245.                      WriteMsg('A)scii X)modem Y)modem ymodem-G): ',1);
  246.                      ReadMsg(ResultMsg,35,1);
  247.                      c := UpCase(ResultMsg[1]);
  248.                      case c of
  249.                        'A': (* ASCII *)
  250.                           begin
  251.                             Protocol := 'A';
  252.                             (* setup ascii parameters *)
  253.                             TermChar := $18; (* CAN or control-X *)
  254.                             CharPace := 5;   (* 5 ms inter-byte delay *)
  255.                             Timeout := 7;    (* timeout after 7 seconds *)
  256.                             EchoFlag := TRUE;(* local echo *)
  257.                             WriteMsg('Protocol = ASCII',1);
  258.                           end;
  259.                        'X': (* XMODEM *)
  260.                           begin
  261.                             Protocol := 'X';
  262.                             OneKflag := FALSE;
  263.                             NCGbyte := NAK;
  264.                             BatchFlag := FALSE;
  265.                             WriteMsg('Protocol = XMODEM',1);
  266.                           end;
  267.                        'Y': (* YMODEM *)
  268.                           begin
  269.                             Protocol := 'Y';
  270.                             OneKflag := TRUE;
  271.                             NCGbyte := Ord('C');
  272.                             BatchFlag := TRUE;
  273.                             WriteMsg('Protocol = YMODEM',1);
  274.                           end;
  275.                        'G': (* YMODEM-G *)
  276.                           begin
  277.                             Protocol := 'G';
  278.                             OneKflag := TRUE;
  279.                             NCGbyte := Ord('G');
  280.                             BatchFlag := TRUE;
  281.                             WriteMsg('Protocol = YMODEM-G',1);
  282.                           end;
  283.                      end; (* case *)
  284.                      StatusMsg[6] := Protocol;
  285.                      WriteMsg(StatusMsg,40)
  286.                    end;
  287.                 'S': (* Send *)
  288.                    begin
  289.                      WriteMsg(GetNameMsg,1);
  290.                      ReadMsg(Filename,16,20);
  291.                      if Length(FileName) = 0 then goto 500;
  292.                      if Protocol = 'A' then
  293.                        begin
  294.                          (* Ascii *)
  295.                          Flag := TxAscii(Port,Filename,Buffer,CharPace,TermChar,Timeout,EchoFlag);
  296.                        end
  297.                      else
  298.                        begin
  299.                          (* XMODEM or YMODEM or YMODEM-G *)
  300.                          Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
  301.                          if BatchFlag then
  302.                            begin
  303.                              (* send empty filename *)
  304.                              Filename := '';
  305.                              RetCode := SioDelay(5);
  306.                              Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
  307.                            end
  308.                         end
  309.                       end; (* Send *)
  310.                 'R': (* Receive *)
  311.                    begin
  312.                      if Protocol = 'A' then
  313.                        begin
  314.                          (* Ascii *)
  315.                          WriteMsg(GetNameMsg,1);
  316.                          ReadMsg(Filename,16,20);
  317.                          if Length(FileName) = 0 then goto 500;
  318.                          Flag := RxAscii(Port,Filename,Buffer,SIO_BUFFER_SIZE,TermChar,Timeout,EchoFlag);
  319.                        end
  320.                      else
  321.                        begin
  322.                          (* XMODEM or YMODEM or YMODEM-G *)
  323.                          if BatchFlag then
  324.                            repeat
  325.                              WriteMsg('Ready for next file',1);
  326.                              Filename := '';
  327.                              Flag := RxyModem(Port,Filename,Buffer,NCGbyte,BatchFlag);
  328.                            until KeyPressed or (Length(Filename) = 0)
  329.                          else
  330.                            begin (* not BatchFlag *)
  331.                              WriteMsg(GetNameMsg,1);
  332.                              ReadMsg(Filename,16,20);
  333.                              if Length(Filename) = 0 then goto 500;
  334.                              Flag := RxyModem(Port,Filename,Buffer,NCGbyte,BatchFlag);
  335.                            end
  336.                        end
  337.                      end (* Receive *)
  338.                    else WriteMsg('Bad response',1);
  339.                    end; (* case *)
  340.                    500:
  341.                 end; (* ESC *)
  342.               (* send out over serial line *)
  343.               RetCode := SioPutc(Port, TheByte );
  344.               if RetCode < 0 then MyHalt( RetCode );
  345.             end (* keypressed *)
  346.       end (* while TRUE *)
  347. end.
  348.